'************************************************************************
'*                                                                      *
'*   File Name      :  4462_iec.bas     Version: V 200001 deu           *
'*                                                                      *
'*   entwickelt von :  Thomas Meder     am 2000.02.22                   *
'*   gendert von   :                   am YYYY.MM.DD                   *
'*                                                                      *
'*   Sprache        :  QBASIC 4.5       Betriebssystem: MS-DOS 6.22     *
'*                                                                      *
'*   Beschreibung   :  Beispielprogramm zum senden und empfangen von    *
'*                     SCPI-Befehlen an den Digistanten Typ 4462        *
'*                     ber die Schnittstelle IEEE-488                  *
'*                                                                      *
'*   Anmerkung      :  Zum laden der IEC-Bus Treiber Library muss das   *
'*                     QB45-Basic in einer Batch Datei wie folgt auf-   *
'*                     gerufen werden:                                  *
'*                     "qb 4462_iec.bas /L c:\AT-GPIB\QBASIC\QBIB.QLB"  *
'*                     Die Erzeugung der QBIB.QLB ist in der Readme-    *
'*                     der IEC-BUS-Karte (AT-GPIB/TNT von National      *
'*                     Instruments) beschrieben.                        *
'*                                                                      *
'*   Copyright by burster przisionsmesstechnik, Gernsbach 07224-6450   *
'*                                                                      *
'************************************************************************

'$INCLUDE: 'c:\at-gpib\qbasic\qbdecl.bas'
 
DECLARE SUB gpiberr (msg$)

DIM choice$(10)
DIM befehl$(50)
DIM val$(50)
DIM message$(50)

CLS     'Bildschirm lschen

PRINT "**********************************************************************"
PRINT "* Dies ist ein Beispielprogramm zum steuern des DIGISTANTEN TYP 4462 *"
PRINT "* ber die IEEE-488-Schnittstelle                                    *"
PRINT "**********************************************************************"

LOCATE 7, 1
INPUT " Geben Sie bitte die IEC-Adresse des Digistanten Typ 4462 ein: ", adr
PRINT " Eingestellte Adresse: ", adr            'Gerteadressnummer bernehmen

'  Diesem 488.2-Befehl wird als Parameter die Gerteadresse und der
'  Timeout bergeben. Als Rckgabe erhlt man die Gertehandle-ID (id4462).
CALL IBDEV(0, adr, 0, T10s, 1, 0, id4462%)
IF (id4462% < 0) THEN
  CALL gpiberr("ibdev Error")
  SYSTEM
END IF
PRINT " Zugeteilte Gertehandle-ID: ", id4462%  'Gertehandle-ID anzeigen

LOCATE 11, 1
PRINT " Bitte whlen Sie die gewnschte Funktion:"
PRINT " ========================================="
PRINT " Spannungswert ausgeben      :   1 "
PRINT " Stromwert ausgeben          :   2 "
PRINT " Eingestellter Wert abfragen :   3 "
PRINT " ABBRUCH                     :  <#>"

WHILE choice$ <> "#"            'Solange Taste <#> nicht gedrckt
LOCATE 18, 1                    'Textausgaben auf Bildschirm lschen
PRINT "                                                                             "
LOCATE 18, 1
INPUT " Bitte Auswahl treffen: "; choice$  'Auswahl bernehmen

LOCATE 20, 1                    'Textausgaben auf Bildschirm lschen
PRINT "                                                                             "
LOCATE 21, 1
PRINT "                                                                             "
befehl$ = ""

IF (choice$ = "1") THEN         'Spannungswert ausgeben
  GOSUB SENDVOLTAGE
END IF
IF (choice$ = "2") THEN         'Stromwert ausgeben
  GOSUB SENDCURRENT
END IF
IF (choice$ = "3") THEN         'Eingestellter Wert abfragen
  GOSUB GETVALUE
END IF
WEND

CLS
END                             'Programm beenden
SYSTEM


SENDVOLTAGE:                    'Subroutine: Spannungswert senden
LOCATE 18, 1
INPUT " Bitte Spannungswert mit Einheit (UV, MV, V) eingeben: ", val$
befehl$ = "SOUR:VOLT " + val$   'Befehl zusammensetzen
GOSUB SENDBEFEHL                'Befehl senden
GOSUB CHECKSTATE                'Gertestatus berprfen
RETURN
 

SENDCURRENT:                    'Subroutine: Stromwert senden
LOCATE 18, 1
INPUT "Bitte Stromwert mit Einheit (UA, MA) eingeben: ", val$
befehl$ = "SOUR:CURR " + val$   'Befehl zusammensetzen
GOSUB SENDBEFEHL                'Befehl senden
GOSUB CHECKSTATE                'Gertestatus berprfen
RETURN


GETVALUE:                       'Subroutine: Eingestellter Wert abholen
befehl$ = "SOUR:VOLT?"          'Befehl zusammensetzen
GOSUB SENDBEFEHL                'Befehl senden
GOSUB GETMESSAGE                'Antwort einholen
GOSUB CHECKSTATE                'Gertestatus berprfen
RETURN


SENDBEFEHL:                     'Subroutine: Befehl senden
message$ = befehl$ + CHR$(10)   'Befehlsstring zusammensetzen
CALL IBWRT(id4462%, message$)   'Befehl ber IEC-Bus senden
IF (IBSTA% AND EERR) THEN
  CALL gpiberr("ibwrt Error")   'Routine zur Fehlerbehandlung
  SYSTEM
END IF
LOCATE 20, 1
PRINT "                                   "
LOCATE 20, 1
PRINT " Gesendeter Befehl: "; befehl$  'Gesendeter Befehl anzeigen
RETURN


GETMESSAGE:                     'Subroutine: Eingestellter Wert einholen
message$ = SPACE$(12)           'Buffer unbedingt vorbesetzen
LOCATE 21, 1
PRINT "                                        "
CALL IBRD(id4462%, message$)    'Antwort ber IEC-Bus einlesen
IF (IBSTA% AND EERR) THEN
  CALL gpiberr("ibrd Error")    'Routine zur Fehlerbehandlung
  SYSTEM
ELSE
  LOCATE 21, 1
  PRINT " Eingestellter Wert: "; message$ 'Eingestellter Wert anzeigen
END IF
RETURN


CHECKSTATE:                     'Routine: Prfen, ob Befehl erfolgreich ausgefhrt
message$ = "*ESR?" + CHR$(10)   'Abfrage des Standard Event Registers
CALL IBWRT(id4462%, message$)   'Befehl ber IEC-Bus senden
IF (IBSTA% AND EERR) THEN
  CALL gpiberr("ibwrt Error")   'Routine zur Fehlerbehandlung
  SYSTEM
END IF
message$ = SPACE$(12)           'Buffer unbedingt vorbesetzen
CALL IBRD(id4462%, message$)    'Antwort ber IEC-Bus einlesen
IF (IBSTA% AND EERR) THEN
  CALL gpiberr("ibrd Error")    'Routine zur Fehlerbehandlung
  SYSTEM
ELSE
  fail = VAL(message$)          'String in Zahlenwert umwandeln

  ' Falls der Befehl vom Gert nicht erkannt wird, kann im Standard
  ' Event Status Register der Fehlerstatus abgefragt werden.
  ' Bit 4: Es liegt ein Fehler in der Ausfhrung eines Befehls vor
  ' Bit 5: Ein Befehl wird nicht erkannt

  IF fail = 16 OR fail = 24 THEN   'Registerwert auswerten
	LOCATE 21, 1
	PRINT " Befehl wurde vom Gert nicht erkannt !                     "
	LOCATE 22, 1
	PRINT "                                                            "
  END IF
END IF
RETURN

SUB gpiberr (msg$) STATIC
'=============================================================================
'                      Subroutine GPIBERR
'  This subroutine will notify you that a NI-488 function failed by printing
'  an error message.  The status variable IBSTA% will also be printed
'  in hexadecimal along with the mnemonic meaning of the bit position.
'  The status variable IBERR% will be printed in decimal along with the
'  mnemonic meaning of the decimal value.  The status variable IBCNT% will
'  be printed in decimal.
'
'  The NI-488 function IBONL is called to disable the hardware and software.
'
'  The STOP command will terminate this program.
'=============================================================================
'

   PRINT msg$

   PRINT "ibsta = &H"; HEX$(IBSTA%); " <";
   IF IBSTA% AND EERR THEN PRINT " ERR";
   IF IBSTA% AND TIMO THEN PRINT " TIMO";
   IF IBSTA% AND EEND THEN PRINT " END";
   IF IBSTA% AND SRQI THEN PRINT " SRQI";
   IF IBSTA% AND RQS THEN PRINT " RQS";
   IF IBSTA% AND SPOLL THEN PRINT " SPOLL";
   IF IBSTA% AND EEVENT THEN PRINT " EVENT";
   IF IBSTA% AND CMPL THEN PRINT " CMPL";
   IF IBSTA% AND LOK THEN PRINT " LOK";
   IF IBSTA% AND RREM THEN PRINT " REM";
   IF IBSTA% AND CIC THEN PRINT " CIC";
   IF IBSTA% AND AATN THEN PRINT " ATN";
   IF IBSTA% AND TACS THEN PRINT " TACS";
   IF IBSTA% AND LACS THEN PRINT " LACS";
   IF IBSTA% AND DTAS THEN PRINT " DTAS";
   IF IBSTA% AND DCAS THEN PRINT " DCAS";
   PRINT " >"
 
   PRINT "iberr = "; IBERR%;
   IF IBERR% = EDVR THEN PRINT " EDVR <DOS Error>"
   IF IBERR% = ECIC THEN PRINT " ECIC <Not CIC>"
   IF IBERR% = ENOL THEN PRINT " ENOL <No Listener>"
   IF IBERR% = EADR THEN PRINT " EADR <Address error>"
   IF IBERR% = EARG THEN PRINT " EARG <Invalid argument>"
   IF IBERR% = ESAC THEN PRINT " ESAC <Not Sys Ctrlr>"
   IF IBERR% = EABO THEN PRINT " EABO <Op. aborted>"
   IF IBERR% = ENEB THEN PRINT " ENEB <No GPIB board>"
   IF IBERR% = EOIP THEN PRINT " EOIP <Async I/O in prg>"
   IF IBERR% = ECAP THEN PRINT " ECAP <No capability>"
   IF IBERR% = EFSO THEN PRINT " EFSO <File sys. error>"
   IF IBERR% = EBUS THEN PRINT " EBUS <Command error>"
   IF IBERR% = ESTB THEN PRINT " ESTB <Status byte lost>"
   IF IBERR% = ESRQ THEN PRINT " ESRQ <SRQ stuck on>"
   IF IBERR% = ETAB THEN PRINT " ETAB <Table Overflow>"
 
   PRINT "ibcnt = "; IBCNT%

END SUB

